Delphi 2 - Developers' Solutions/Delphi 2 Developers' Solutions.iso/dds/chap10/howto05/delphi10/ccicnntp.pas

Pascal/Delphi Source File | 1996-06-12 | 36.5 KB | 1,024 lines

unit Ccicnntp;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  CCICCPrf, IniFiles, Gauges, CCiccfrm;
type
  { Component to hold NNTP handling capabilities }
  TNNTPComponent = class( TWinControl )
  public
    NNTPCommandInProgress ,
    Connection_Established : Boolean;
    Socket1 : TCCSocket;
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
    function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
    function Disconnect : Boolean;
    function DoCStyleFormat(       TheText      : string;
                             const TheArguments : array of const ) : String;
    procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
    procedure AddProgressText( WhatText : String );
    procedure ShowProgressText( WhatText : String );
    procedure ShowProgressErrorText( WhatText : String );
    function GetNNTPServerResponse( var ResponseString : String ) : integer;
    procedure NNTPSocketsErrorOccurred( Sender     : TObject;
                                     ErrorCode  : Integer;
                                     TheMessage : String   );
    function PerformNNTPCommand(
                    TheCommand   : string;
              const TheArguments : array of const ) : Integer;
    function PerformBlindNNTPCommand( TheCommand   : string ) : Integer;
    function PerformNNTPExtendedCommand(
                    TheCommand   : string;
              const TheArguments : array of const ) : Integer;
    function GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
    function GetNextSDItem(     WorkingString : String;
                            var TheIndex      : Integer ) : String;
    function GetListOfAvailableNewsGroups : Boolean;
    function PurgeReadSentArticleListings( TheNGRecord : PNewsGroupRecord ): Boolean;
    procedure ParseNewsGroupListing(     TheListing : String;
                                     var GroupName  : String;
                                     var LowCurrent : Longint;
                                     var HighCurrent : Longint;
                                     var Postable    : Boolean  );
    function SetCurrentNewsGroup( TheNGRecord : PNewsGroupRecord;
                                  DoUpdate    : Boolean           ) : Boolean;
    function CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
    function CheckAllNewNews : Boolean;
    procedure ParseArticleListing(     TheListing       : String;
                                   var TotalAvailable   : Longint;
                                   var LowestAvailable  : Longint;
                                   var HighestAvailable : Longint );
    function GetArticleHeader( TheNumber     : Longint;
                               TheReturnList : TStringList ) : Boolean;
    function GetAllArticleHeaders( TheNGRecord : PNewsGroupRecord ) : Boolean;
    function GetHeaderSubject( HList : TStringList ) : String;
    function GetHeaderSender( HList : TStringList ) : String;
  end;

implementation

{ This function calls an extended response NNTP command routine }
function TNNTPComponent.PerformNNTPExtendedCommand(
               TheCommand   : string;
         const TheArguments : array of const ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if NNTPCommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  NNTPCommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := Format( TheCommand , TheArguments );
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This function gets an extended period-ended multiline response from the server }
function TNNTPComponent.GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
var
  { Assume ResponseString already allocated as 0..513 }
  { Pointer to the response string }
  TheBuffer ,
  BufferPointer : array[0..255] of char;
  HolderBuffer : array[0..513] of char;
  { Character to check for response code }
  ResponseChar   : char;
  { Pointers into returned string }
  TheIndex ,
  TheLength     : integer;
  { Control variable }
  LeftoversInPan ,
  Finished      : Boolean;
  BufferString : String;
begin
  { Preset fatal error }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { Start loop control }
  LeftoversInPan := false;
  Finished := false;
  StrCopy( HolderBuffer , '' );
  repeat
    { Do a peek }
    BufferString := Socket1.PeekData;
    { If timeout or other error exit }
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
    { Find end of line character }
    TheIndex := Pos( #10 , BufferString );
    if TheIndex = 0 then
    begin
      TheIndex := Pos( #13 , BufferString );
      if TheIndex = 0 then
      begin
        TheIndex := Pos( #0 , BufferString );
        if TheIndex = 0 then
        begin
          TheIndex := Length( BufferString );
          LeftoversInPan := True;
          StrPCopy( TheBuffer , BufferString );
          StrCat( HolderBuffer , TheBuffer );
          LeftoversOnTable := false;
        end;
      end;
    end;
    { If an end of line then process the line }
    if TheIndex > 0 then
    begin
      { Get length of string }
      TheLength := TheIndex;
      { Receive actual data }
      Socket1.CCSockReceive( Socket1.TheSocket   ,
                             @BufferPointer[ 0 ] ,
                             TheLength              );
      { Abort if timeout or error }
      if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
      { Put in the length byte }
      BufferPointer[ TheLength ] := Chr( 0 );
      if LeftOversOnTable then
      begin
        LeftOversOnTable := false;
        StrCopy( ResponseString , HolderBuffer );
        StrCat( ResponseString , BufferPointer );
      end
      else
      begin
        if not LeftoversInPan then StrCopy( ResponseString , BufferPointer );
      end;
      if LeftoversInPan then
      begin
        LeftoversInPan := false;
        LeftoversOnTable := true;
      end
      else
      begin
        ResponseChar := ResponseString[ 0 ];
        if (( ResponseChar = '.' ) and ( StrLen( ResponseString ) <= 3 )) then
        begin
          Finished := true;
          Result := TCPIP_STATUS_COMPLETED;
        end
        else
        begin
          if ResponseChar = '.' then ResponseString[ 0 ] := ' ';
          Finished := true;
          Result := TCPIP_STATUS_PRELIMINARY;
        end;
      end;
    end;
  until ( Finished and ( not LeftoversOnTable ));
  StrLCopy( ResponseString , ResponseString , StrLen( ResponseString ) - 2 );
end;

{ This function moves along a string from an index, getting the next }
{ string delimited item or last one on string.                       }
function TNNTPComponent.GetNextSDItem(     WorkingString : String;
                                       var TheIndex      : Integer ) : String;
var HoldingString : String;
begin
  HoldingString := Copy( WorkingString , TheIndex + 1 , 255 );
  TheIndex := Pos( ' ' , HoldingString );
  if TheIndex = 0 then
  begin
    Result := HoldingString;
  end
  else
  begin
    HoldingString := Copy( HoldingString , 1 , TheIndex - 1 );
    Result := HoldingString;
  end;
end;

{ This is the first true "network" function; it sends a LIST command, eats }
{ a single 215 response and then grabs PChars of data from the server till }
{ It returns a period character. The returned line is sent to a NEWSGRP    }
{ file and a status update is send through.                                }
function TNNTPComponent.GetListOfAvailableNewsGroups : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    HoldPChar ,
    TheHoldingPChar ,
    TheReturnPChar  : PChar;
    TheNGFile       : TextFile;
    D1 , D2     : Longint;
    D3          : Boolean;
    GroupString : String;
    TotalGroups : Longint;
begin
  Result := false;
  TheReturnString :=
   DoCStyleFormat( 'LIST' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformNNTPCommand( 'LIST', [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    NNTPCommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetNNTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  NNTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'LIST Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end;
  try
    AssignFile( TheNGFile , NewsPath + '\NEWSGRP.TXT' );
    Rewrite( TheNGFile );
  except
    Socket1.OutOfBand := 'ABOR'+#13#10;
    repeat
      TheResult := GetNNTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    Result := false;
    exit;
  end;
  GetMem( TheReturnPChar , 514 );
  HoldPChar := TheReturnPChar;
  TotalGroups := 0;
  CCICInfoDlg.ListBox1.Clear;
  repeat
    Application.ProcessMessages;
    if GlobalAbortedFlag then exit;
    Inc(TotalGroups );
    TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
    if StrLen( TheReturnPChar ) > 255 then
    begin
      Getmem( TheHoldingPChar , 255 );
      while StrLen( TheReturnPChar ) > 255 do
      begin
        StrCopy( TheHoldingPChar , '' );
        StrMove( TheHoldingPChar , TheReturnPChar , 255 );
        TheReturnPChar := TheReturnPChar + 256;
        TheReturnString := StrPas( TheHoldingPChar );
        ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
      end;
      FreeMem( TheHoldingPChar , 255 );
      Writeln( TheNGFile , GroupString );
      CCICInfoDlg.ListBox1.Items.Add( GroupString );
      CCINetCCForm.Panel1.Caption := GroupString +
       '(' + IntToStr( TotalGroups ) + ')';
    end
    else
    begin
      TheReturnString := StrPas( TheReturnPChar );
      ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
      Writeln( TheNGFile , GroupString );
      CCICInfoDlg.ListBox1.Items.Add( GroupString );
      CCINetCCForm.Panel1.Caption := GroupString +
       '(' + IntToStr( TotalGroups ) + ')';
    end;
  until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  FreeMem( HoldPChar , 514 );
  CloseFile( TheNGFile );
  Result := true;
  CCINetCCForm.Panel1.Caption := 'Finished LIST!';
end;

{ This method sets a news group and updates its internal data }
function TNNTPComponent.CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
begin
  { Gee, that was easy! }
  Result := SetCurrentNewsGroup( TheNGRecord , true );
end;

{ This method takes all the data in the NewsRCList and if subscribed, CNN's it }
function TNNTPComponent.CheckAllNewNews : Boolean;
var Counter_1   : Integer;
    TheNGRecord : PNewsGroupRecord;
begin
  Result := true;
  for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  begin
    TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
    if TheNGRecord^.GSubScribed then Result := CheckForNewNews( TheNGRecord );
  end;
end;

{ This method splits up a listing and pulls out its component data }
procedure TNNTPComponent.ParseNewsGroupListing(     TheListing : String;
                                var GroupName  : String;
                                var LowCurrent : Longint;
                                var HighCurrent : Longint;
                                var Postable    : Boolean  );
var HoldingString ,
    HoldingString2 : String;
    WorkingIndex  : Integer;
begin
  WorkingIndex := Pos( ' ' , TheListing );
  if WorkingIndex = 0 then
  begin
    GroupName := TheListing;
    LowCurrent :=  -1;
    HighCurrent := -1;
    Postable := false;
    exit;
  end;
  GroupName := Copy( TheListing , 1 , WorkingIndex - 1 );
  HoldingString := Copy( TheListing , WorkingIndex + 1 , 255 );
  WorkingIndex := Pos(  ' ' , HoldingString );
  HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  LowCurrent := StrToInt( HoldingString2 );
  HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
  WorkingIndex := Pos(  ' ' , HoldingString );
  HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  HighCurrent := StrToInt( HoldingString2 );
  HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
  if (( HoldingString[ 1 ] = 'y' ) or ( HoldingString[ 1 ] = 'Y' )) then
   Postable := true else Postable := false;
end;

{ This is another "Network" command which sets the GROUP to the name of the }
{ imported record. The imported record is also updated to reflect current   }
{ available articles.                                                       }
function TNNTPComponent.SetCurrentNewsGroup(
          TheNGRecord : PNewsGroupRecord; DoUpdate : Boolean ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    TAA , LAA , HAA : Longint;
begin
  TheReturnString :=
   DoCStyleFormat( 'GROUP %s' ,
    [ TheNGRecord^.GRealName ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformNNTPCommand( 'GROUP %s',
                                  [ TheNGRecord^.GRealName ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    NNTPCommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetNNTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  NNTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'GROUP %s Not Available!' ,
      [ TheNGRecord^.GRealName ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end;
  Result := True;
  { Leave if only want to set group }
  if not DoUpdate then exit;
  { Split out the articles listing into its three numbers }
  ParseArticleListing( TheReturnString , TAA , LAA , HAA );
  { Work on the numbers to make sure display is consistent }
  with TheNGRecord^ do
  begin
    { Set internal pointers }
    GTotalAvailable := TAA;
    GLowestAvailable := LAA;
    GHighestAvailable := HAA;
    if GLowest < GLowestAvailable then
    begin { All stored articles have expired or there are none }
      GTotalNew := GTotalAvailable;      { Total new is total available    }
      GLowest := GLowestAvailable - 1;   { set low and high to below start }
      GHighest := GLowestAvailable - 1; { until something is read }
    end
    else
    begin { Some read articles haven't expired; assume all still good }
      GTotalNew := GHighestAvailable - GHighest; { Total since last download }
      if GTotalNew < 0 then GTotalNew := 0; { Just in case... }
    end;
  end;
end;

{ This method splits out the GROUP response line into TAA, LAA , HAA }
procedure TNNTPComponent.ParseArticleListing(     TheListing       : String;
                              var TotalAvailable   : Longint;
                              var LowestAvailable  : Longint;
                              var HighestAvailable : Longint );
var WorkingString ,
    WorkingString2 : String;
    WorkingIndex   : Integer;
begin
  WorkingString := Copy( TheListing , 5, 255 );
  WorkingIndex := Pos( ' ' , WorkingString );
  WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  TotalAvailable := StrToInt( WorkingString2 );
  WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
  WorkingIndex := Pos( ' ' , WorkingString );
  WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  LowestAvailable := StrToInt( WorkingString2 );
  WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
  WorkingIndex := Pos( ' ' , WorkingString );
  WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  HighestAvailable := StrToInt( WorkingString2 );
end;

{ This method uses the HEAD command to get a complete article header }
function TNNTPComponent.GetArticleHeader( TheNumber     : Longint;
                          TheReturnList : TStringList ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    HoldPChar ,
    TheReturnPChar ,
    TheHoldingPChar : PChar;
begin
  TheReturnString :=
   DoCStyleFormat( 'HEAD %d' ,
    [ TheNumber ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformNNTPCommand( 'HEAD %d', [ TheNumber ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    NNTPCommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetNNTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  NNTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'Head %d Failed!' ,
      [ TheNumber ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end;
  GetMem( TheReturnPChar , 514 );
  HoldPChar := TheReturnPchar;
  TheReturnList.Clear;
  repeat
    TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
    if StrLen( TheReturnPChar ) > 255 then
    begin
      Getmem( TheHoldingPChar , 255 );
      while StrLen( TheReturnPChar ) > 255 do
      begin
        StrCopy( TheHoldingPChar , '' );
        StrMove( TheHoldingPChar , TheReturnPChar , 255 );
        TheReturnPChar := TheReturnPChar + 256;
        TheReturnString := StrPas( TheHoldingPChar );
        TheReturnList.Add( TheReturnString );
      end;
      StrCopy( TheHoldingPChar , '' );
      StrMove( TheHoldingPChar , TheReturnPChar , StrLen( TheReturnPChar ));
      TheReturnString := StrPas( TheHoldingPChar );
      TheReturnString := '\' + TheReturnString;
      TheReturnList.Add( TheReturnString );
      FreeMem( TheHoldingPChar , 255 );
    end
    else
    begin
      TheReturnString := StrPas( TheReturnPChar );
      TheReturnList.Add( TheReturnString );
    end;
  until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  FreeMem( HoldPChar , 514 );
  Result := true;
end;

{ This method parses a header stringlist and obtains the subject line }
function TNNTPComponent.GetHeaderSubject( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '[No Subject]';
  while (( not Finished ) and ( Counter_1 < HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'SUBJECT:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 9 , 255 );
      Finished := true;
    end
    else Counter_1 := Counter_1 + 1;
  end;
  Result := WorkingString;
end;

{ This method parses a header stringlist and obtains the sender's ID }
function TNNTPComponent.GetHeaderSender( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 < HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'FROM:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 6 , 255 );
      Finished := true;
    end
    else Counter_1 := Counter_1 + 1;
  end;
  Result := WorkingString;
end;


{ This method updates the available headers in the header file for a newsgroup }
function TNNTPComponent.GetAllArticleHeaders( TheNGRecord : PNewsGroupRecord ) : Boolean;
var TheNGARecord   : PNewsGroupArticleRecord;
    Counter_1      : Integer;
    TheHeaderList  : TStringList;
    WorkingList    : TList;
    WorkingCounter : Longint;
begin
  { Do this for ease of coding }
  with TheNGRecord^ do
  begin
    { Get the current TList of article headers }
    WorkingList := TList( GLTag );
    { Set Group Command without updating }
    if not SetCurrentNewsGroup( TheNGRecord , false ) then
    begin
      { Abort if can't get newsgroup }
      Result := false;
      exit;
    end;
    { create the stringlist for header info }
    TheHeaderList := TStringList.Create;
    { Determine how many to get from computed availability }
    WorkingCounter := GHighestAvailable - GTotalNew + 1;
    { Run up to total new articles }
    for Counter_1 := 1 to GTotalNew do
    begin
      { Try to get the header }
      if GetArticleHeader( WorkingCounter , TheHeaderList ) then
      begin
        { If succeed create new header record }
        New( TheNGARecord );
        with TheNGARecord^ do
        begin
          { Fill in all the fields with nominal or acquired data }
          NGAGroupname   := GRealName;
          NGASubject     := GetHeaderSubject( TheHeaderList );
          NGANumber      := WorkingCounter;
          NGADownloaded  := false;
          NGASender      := GetHeaderSender( TheHeaderList );
          NGARead        := false;
          NGAPosted      := false;
          NGAArtFileName := '';
        end;
        { Put record on list }
        WorkingList.Add( TheNGARecord );
      end;
      { Either way increment the counter }
      WorkingCounter := WorkingCounter + 1;
    end;
    { Update all the pointer numbers to indicate all article headers gotten }
    GTotalUnreadArticles := GTotalUnreadArticles + GTotalAvailable;
    GTotalArticles := GTotalArticles + GTotalAvailable;
    GTotalAvailable := 0;
    GTotalNew := 0;
    GLowestAvailable := GHighestAvailable;
    GLowest := GLowestAvailable;
    GHighest := GLowestAvailable;
    { Save off the pointer to the modified TList }
    GLTag := Longint( WorkingList );
    { Clean Up and leave }
    Result := true;
    TheHeaderList.Free;
  end;
end;

{ This function deletes all read/sent articles and associated files }
function TNNTPComponent.PurgeReadSentArticleListings(
 TheNGRecord : PNewsGroupRecord ) : Boolean;
var TheNGARecord   : PNewsGroupArticleRecord;
    Counter_1      : Integer;
    WorkingList    : TList;
    Finished       : Boolean;
begin
  { Do this for ease of coding }
  with TheNGRecord^ do
  begin
    { Get the current TList of article headers }
    WorkingList := TList( GLTag );
    { Run up to total new articles }
    for Counter_1 := 0 to WorkingList.Count - 1 do
    begin
      TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
      if ( TheNGARecord^.NGAPosted or TheNGARecord^.NGARead ) then
      begin
        Dec( GTotalArticles );
        if FileExists( NewsPath + '\' + TheNGARecord^.NGAArtFilename ) then
         {DeleteFile( NewsPath + '\' + TheNGARecord^.NGAArtFileName )};
      end;
    end;
    Counter_1 := 0;
    Finished := False;
    while Not Finished do
    begin
      TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
      if ( TheNGARecord^.NGAPosted or TheNGARecord^.NGARead ) then
      begin
        WorkingList.Delete( Counter_1 );
      end
      else Counter_1 := Counter_1 + 1;
      if Counter_1 > WorkingList.Count - 1 then Finished := true;
    end;
  end;
  Result := true;
end;


{ This sends FTP progress text to the Inet form }
procedure TNNTPComponent.ShowProgressErrorText( WhatText : String );
begin
  CCInetCCForm.ShowProgressErrorText( WhatText );
end;

{ This is a core function! It performs an FTP command and if no timeout }
{ return a preliminary ok.                                              }
function TNNTPComponent.PerformNNTPCommand(
                 TheCommand        : string;
           const TheArguments      : array of const ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if NNTPCommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  NNTPCommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := Format( TheCommand , TheArguments );
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This is a core function! It performs an FTP command and if no timeout }
{ return a preliminary ok.                                              }
function TNNTPComponent.PerformBlindNNTPCommand( TheCommand : string ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if NNTPCommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  NNTPCommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := TheCommand;
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This function gets up to 255 chars of data plus a return code from FTP serv }
function TNNTPComponent.GetNNTPServerResponse(
          var ResponseString : String ) : integer;
var
  { Buffer string for response line }
  TheBuffer     : string;
  { Pointer to the response string }
  BufferPointer : array[0..255] of char absolute TheBuffer;
  { Character to check for response code }
  ResponseChar   : char;
  { Pointers into returned string }
  TheIndex ,
  TheLength     : integer;
  { Control variable }
  LeftoversInPan ,
  Finished      : Boolean;
begin
  { Preset fatal error }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { Start loop control }
  LeftoversInPan := false;
  Finished := false;
  repeat
    { Do a peek }
    TheBuffer := Socket1.PeekData;
    { If timeout or other error exit }
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
    { Find end of line character }
    TheIndex := Pos( #10 , TheBuffer );
    if TheIndex = 0 then
    begin
      TheIndex := Pos( #13 , TheBuffer );
      if TheIndex = 0 then
      begin
        TheIndex := Pos( #0 , TheBuffer );
        if TheIndex = 0 then
        begin
          TheIndex := Length( TheBuffer );
          LeftoversInPan := True;
          LeftoverText := LeftoverText + TheBuffer;
          LeftoversOnTable := false;
        end;
      end;
    end;
    { If an end of line then process the line }
    if TheIndex > 0 then
    begin
      { Get length of string }
      TheLength := TheIndex;
      { Receive actual data }
      Socket1.CCSockReceive( Socket1.TheSocket   ,
                             @BufferPointer[ 1 ] ,
                             TheLength              );
      { Abort if timeout or error }
      if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
      { Put in the length byte }
      BufferPointer[ 0 ] := Chr( TheLength );
      if LeftOversOnTable then
      begin
        LeftOversOnTable := false;
        ResponseString := LeftoverText + TheBuffer;
        TheBuffer := ResponseString;
        LeftoverText := '';
      end;
      if LeftoversInPan then
      begin
        LeftoversInPan := false;
        LeftoversOnTable := true;
      end;
      { Get first number character }
      ResponseChar := TheBuffer[ 1 ];
      { Get the value of the number from 1 to 5 }
      if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
      begin
        Finished := true;
        Result := Ord( ResponseChar ) - 48;
      end;
    end
    else
    begin
    end;
  until ( Finished and ( not LeftoversOnTable ));
  { Return buffer as response string }
  ResponseString := TheBuffer;
end;

{ Boilerplate error routine }
procedure TNNTPComponent.NNTPSocketsErrorOccurred( Sender     : TObject;
                                                 ErrorCode  : Integer;
                                                 TheMessage : String   );
begin
  CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
end;

{ This is the FTP components initial connection routine }
function TNNTPComponent.EstablishConnection(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  { Set default FTP Port value }
  Socket1.PortName := '119';
  { Get the ip address from the record }
  Socket1.IPAddressName := PCRPointer^.CIPAddress;
  { Set blocking mode }
  Socket1.AsynchMode := False;
  { Clear condition variables }
  GlobalErrorCode := 0;
  GlobalAbortedFlag := false;
  { Actually attempt to connect }
  Socket1.CCSockConnect;
  { Check if connected }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
      ( Socket1.TheSocket = INVALID_SOCKET )) then
  begin { Didn't connect; signal error and abort }
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else
  begin
    Connection_Established := true;
    { Signal successful connection }
    TheReturnString := DoCStyleFormat(
      'Connected on Local port: %s with IP: %s',
      [ Socket1.GetSocketPort( Socket1.TheSocket ),
        Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat(
     'Connected to Remote port: %s with IP: %s',
      [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
        Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
     [ Socket1.IPAddressName ]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    repeat
      TheResult := GetNNTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
    begin
      { Do clever C formatting trick }
      TheReturnString :=
       DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
        [ PCRPointer^.CIPAddress ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      { Signal error }
      Result := False;
      { leave }
      exit;
    end
    else Result := true; { Signal no problem }
  end;
end;

{ This is the FTP component constructor; it creates 2 sockets }
constructor TNNTPComponent.Create( AOwner : TComponent );
begin
  { do inherited create }
  inherited Create( AOwner );
  { Create socket, put in their parent, and error procs }
  Socket1 := TCCSocket.Create( Self );
  Socket1.Parent := Self;
  Socket1.OnErrorOccurred := NNTPSocketsErrorOccurred;
  { Set up booleans }
  Connection_Established := false;
  NNTPCommandInProgress := false;
end;

{ This is the FTP component destructor; it frees 2 sockets }
destructor TNNTPComponent.Destroy;
begin
  { Free the socket }
  Socket1.Free;
  { and call inherited }
  inherited Destroy;
end;

procedure TNNTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
begin
  CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
end;

{ This sends FTP progress text to the Inet form }
procedure TNNTPComponent.AddProgressText( WhatText : String );
begin
  CCInetCCForm.AddProgressText( WhatText );
end;

{ This sends FTP progress text to the Inet form }
procedure TNNTPComponent.ShowProgressText( WhatText : String );
begin
  CCInetCCForm.ShowProgressText( WhatText );
end;

{ This is the FTP components QUIT routine }
function TNNTPComponent.Disconnect : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'QUIT' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  PerformNNTPCommand( 'QUIT', [ nil ] );
  repeat
    TheResult := GetNNTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  NNTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'NNTP Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is a clever c-style formatting trick }
function TNNTPComponent.DoCStyleFormat(
                TheText      : string;
          const TheArguments : array of const ) : String;
begin
  Result := Format( TheText , TheArguments ) + #13#10;
end;


end.